Analysis of the portfolios regarding the MSCI Spain
Emanuel Sommer
In this analysis different portfolios consisting of stocks that are
among the top 10 constituents of the MSCI Spain Index are backtested
using the functionality of the portvine package. First the
most important packages are loaded and after that the data will be
imported and discussed shortly.
# main workhorse for the estimation of risk measures
library(portvine)
# general data wrangling and visualizations
library(tidyverse)
# arrange ggplots nicely
library(patchwork)
# utility color vector for visualizations
custom_colors <- c("#92B8DE", "#db4f59", "#477042", "#cc72d6")
theme_set(
theme_minimal() +
theme(plot.title = ggtext::element_markdown(size = 11),
plot.subtitle = ggtext::element_markdown(size = 9))
)
Sys.setlocale("LC_TIME", "English")
# load the data
load(here::here("data", "msci_spain_data_clean.RData"))
# source utils
source(here::here("analysis_utils.R"))A first glimpse at the data
glimpse(msci_spain_complete_data)## Rows: 1,695
## Columns: 13
## $ date <dttm> 2015-05-11, 2015-05-12, 2015-05-13, 2015-05-14, 2015~
## $ msci_spain_index <dbl> -0.0003077472, -0.0082391913, -0.0029852937, 0.004217~
## $ iberdrola <dbl> 0.0044134899, -0.0011447704, 0.0084790041, 0.00438339~
## $ banco_santander <dbl> -0.0013274410, -0.0148344281, -0.0035906090, 0.009393~
## $ inditex <dbl> -0.004312954, -0.004331636, -0.006969884, 0.012165600~
## $ cellnex_telecom <dbl> -0.016530307, 0.006643209, 0.026148592, 0.019166054, ~
## $ repsol_ypf <dbl> 0.0002758643, -0.0041296843, -0.0024876548, 0.0046928~
## $ ferrovial <dbl> 0.0065986178, -0.0099143271, 0.0106753099, 0.00580057~
## $ amadeus_it_group <dbl> 0.0080103947, 0.0107436023, -0.0065789711, -0.0036737~
## $ telefonica <dbl> 0.0057893368, -0.0405038229, -0.0003810002, -0.010201~
## $ bbv_argentaria <dbl> -0.0042779936, -0.0055121217, -0.0008861844, 0.013735~
## $ sp500 <dbl> 0.0029540152, 0.0003049362, -0.0107215489, -0.0007681~
## $ eurostoxx50 <dbl> -0.006893194, -0.014257898, -0.005523096, 0.000000000~One can see that there are 13 columns. The date column
gives obviously the date as daily return data will be analyzed here. The
daily log returns of the overall index are given in the column
msci_spain_index, eurostoxx50 contains the
corresponding daily log returns of the Eurostoxx 50 index,
sp500 the daily log return of the SP500 index and all other
columns contain the daily log returns of the respective stocks within
the MSCI spain.
summary(msci_spain_complete_data$date)## Min. 1st Qu.
## "2015-05-11 00:00:00.0000" "2016-12-22 12:00:00.0000"
## Median Mean
## "2018-08-08 00:00:00.0000" "2018-08-08 09:41:05.8407"
## 3rd Qu. Max.
## "2020-03-24 12:00:00.0000" "2021-11-08 00:00:00.0000"nrow(msci_spain_complete_data)## [1] 1695This means that the time frame is from the 11th Mai of 2015 until the 8th November of 2021 and there are 1695 observations. Below one can have a look at daily log returns of the overall MSCI Spain index.
So one can observe greater volatility during the stock market selloffs 2015-2016 maybe due to Chinese stock market turbulence, the EU dept crisis and the Brexit votum as well as for the first ‘Covid-19 year’ 2020. The period with the pandemic in place allows to test the backtesting in a higher volatility setting. Thus one will specify the following two time frames of interest.
- 01.01.2016 - 31.12.2019, the filtered data is
contained in
msci_spain_16_19 - 02.04.2020 - 13.10.2021, the filtered data is
contained in
msci_spain_20_21
As all risk estimations are based on the rather high sample size
\(S\) of 100000 all risk estimations
were performed remotely at the Leibniz supercomputing centre and the
results saved. This allows to exploit the nested parallelization
provided by the portvine package.
Unconditional risk measure estimation
The portfolio is here given via 9 assets:
- Iberdrola
- Banco Santander
- Inditex
- Cellnex Telecom
- Repsol
- Ferrovial
- Amadeus It Group
- Telefonica
- BBV Argentaria
The portfolio is weighted according to their respective market capitalization on the 29.10.2021.
# weights according to the market capitalization on the 29.10.21
weights_values <- c(
iberdrola = 60.48,
banco_santander = 56.82,
bbv_argentaria = 40.42,
inditex = 34.08,
cellnex_telecom = 27.09,
amadeus_it_group = 26.06,
telefonica = 19.37,
repsol_ypf = 16.04,
ferrovial = 12.99
)msci_spain_complete_data %>%
select(-sp500, -eurostoxx50) %>%
pivot_longer(-date) %>%
mutate(name = str_to_title(str_replace_all(name, "_", " ")),
name = fct_inorder(name)) %>%
ggplot(aes(x = date, y = value)) +
geom_line() +
labs(x = "", y = "Daily log returns") +
facet_wrap(~name, ncol = 2)
msci_spain_complete_data %>%
select(-sp500, -msci_spain_index) %>%
pivot_longer(-date) %>%
mutate(name = str_to_title(str_replace_all(name, "_", " ")),
name = fct_inorder(name)) %>%
ggplot(aes(x = date, y = value)) +
geom_line() +
labs(x = "", y = "Daily log returns") +
facet_wrap(~name, ncol = 2)
One always estimates all available risk measures i.e. VaR and the ES with all three estimation methods (mean, median and monte carlo integration based on 10000 samples). The \(\alpha\) levels estimated are 0.01, 0.025, 0.05 and 0.95.
For the marginal models one uses as a default the commonly used ARMA(1,1)-GARCH(1,1) model. If a lack of fit is detected one can adjust this. The training window size for the marginal windows is fixed to 750 days which are roughly 3 financial years in the first time frame and to 300 days in the second time frame. For both time frames the refitting frequency is 50 days which are roughly 2 financial months.
In the unconditional case one allows for the general class of R-vine copulas and uses all available parametric bivariate building blocks. For the vine training size different specifications will be evaluated. For the first time frame one tries the vine training window lengths of 250 and 500 and for the second one 100 and 200. For both time frames one tries the two refitting frequencies of 25 and 50.
# load the unconditional models
load(here::here("data", "msci_spain_uncond_res.RData"))
load(here::here("data", "msci_spain_uncond_gausst.RData"))
load(here::here("data", "msci_spain_uncond_dvines.RData"))Display the summary of two of the models.
summary(uncond_risk_roll_16_19_g50_k25_p250)## An object of class <portvine_roll>
##
## --- Marginal models ---
## Number of ARMA-GARCH/ marginal windows: 6
## Train size: 750
## Refit size: 50
##
## --- Vine copula models ---
## Number of vine windows: 12
## Train size: 250
## Refit size: 25
## Vine copula type: rvine
## Vine family set: parametric
##
## --- Risk estimation ---
## Risk measures estimated: VaR ES_mean ES_mc ES_median
## Alpha levels used: 0.01 0.025 0.05 0.95
## Number of estimated risk measures: 4672
## Number of samples for each risk estimation: 1e+05
##
## Time taken: 6.7735 minutes.summary(uncond_risk_roll_20_21_g50_k25_p200)## An object of class <portvine_roll>
##
## --- Marginal models ---
## Number of ARMA-GARCH/ marginal windows: 2
## Train size: 300
## Refit size: 50
##
## --- Vine copula models ---
## Number of vine windows: 4
## Train size: 200
## Refit size: 25
## Vine copula type: rvine
## Vine family set: parametric
##
## --- Risk estimation ---
## Risk measures estimated: VaR ES_mean ES_mc ES_median
## Alpha levels used: 0.01 0.025 0.05 0.95
## Number of estimated risk measures: 1600
## Number of samples for each risk estimation: 1e+05
##
## Time taken: 5.9738 minutes.Assessment of the marginal model fit.
As the marginal models are the same for each time frame one has a look at the the respective models. First the time frame from 2016 up to 2019. One only has a look at the model corresponding to the first marginal window which will be done here for simplicity but it might also in practice be a reasonable approach as one then only uses the training data available before starting the rolling window risk estimation.
marg_viz_uncond_risk_roll_16_19 <- marg_resid_viz_list(
uncond_risk_roll_16_19_g50_k25_p250
)
marg_viz2_uncond_risk_roll_16_19 <- marg_resid_viz_list(
uncond_risk_roll_16_19_g50_k25_p250, squared = TRUE
)for (asset in names(marg_viz_uncond_risk_roll_16_19)) {
print(marg_viz_uncond_risk_roll_16_19[[asset]])
print(marg_viz2_uncond_risk_roll_16_19[[asset]])
}
A more comprehensive yet less informative visualization is achieved via the heatmap below.
ljung_heatmap(uncond_risk_roll_16_19_g50_k25_p250)
ljung_heatmap(uncond_risk_roll_16_19_g50_k25_p250, roll_num = 6)
The interactive version even allows to see how the marginal models of all the marginal windows behave w.r.t. the Ljung Box test.
ljung_heatmap_animation(uncond_risk_roll_16_19_g50_k25_p250)## Warning: No renderer available. Please install the gifski, av, or magick package
## to create animated outputThus it is quite obvious that the default specification of an ARMA(1,1)-GARCH(1,1) model does a good job. The only two questionable marginal models would be Ferrovial and Cellnex. But as the quality breaches only appear beyond the third lag one will for now hold on to the default model.
Next up the second time frame from 02.04.2020 - 13.10.2021.
marg_viz_uncond_risk_roll_20_21 <- marg_resid_viz_list(
uncond_risk_roll_20_21_g50_k25_p200
)
marg_viz2_uncond_risk_roll_20_21 <- marg_resid_viz_list(
uncond_risk_roll_20_21_g50_k25_p200, squared = TRUE
)for (asset in names(marg_viz_uncond_risk_roll_20_21)) {
print(marg_viz_uncond_risk_roll_20_21[[asset]])
print(marg_viz2_uncond_risk_roll_20_21[[asset]])
}
A more comprehensive yet less informative visualization is again achieved via the heatmap below.
ljung_heatmap(uncond_risk_roll_20_21_g50_k25_p200)
ljung_heatmap(uncond_risk_roll_20_21_g50_k25_p200, roll_num = 2)
The interactive version again allows to see how the marginal models of all the marginal windows behave w.r.t. the Ljung Box test.
ljung_heatmap_animation(uncond_risk_roll_20_21_g50_k25_p200)## Warning: No renderer available. Please install the gifski, av, or magick package
## to create animated outputHere the fit of Banco Santander is the most questionable but as it is a short call one will first stick to the default model for all marginal models.
A look at the R-vines
Next up one can analyze the fitted R-vines. The most interesting questions that arise in this context are which bivariate building blocks were fitted and how strong their dependence is. Also it might be interesting to detect changing patterns over time. Again one starts with the first time frame.
labeled_vinecop_plot(fitted_vines(uncond_risk_roll_16_19_g50_k25_p250)[[1]])
labeled_vinecop_plot(fitted_vines(uncond_risk_roll_16_19_g50_k25_p250)[[6]])
labeled_vinecop_plot(fitted_vines(uncond_risk_roll_16_19_g50_k25_p250)[[12]])
bicops_used(fitted_vines(uncond_risk_roll_16_19_g50_k25_p250)[[1]])##
## bb7 clayton frank gaussian gumbel indep joe t
## 1 5 12 3 5 7 1 2bicops_used(fitted_vines(uncond_risk_roll_16_19_g50_k25_p250)[[6]])##
## bb8 clayton frank gaussian gumbel indep joe t
## 1 5 8 3 6 7 1 5bicops_used(fitted_vines(uncond_risk_roll_16_19_g50_k25_p250)[[12]])##
## bb8 clayton frank gaussian gumbel indep joe t
## 1 1 4 6 5 9 5 5So there is definitely a change over time visible as well as the use of non Student’s t/Gaussian components. The same analysis can be performed on the second time frame.
labeled_vinecop_plot(fitted_vines(uncond_risk_roll_20_21_g50_k25_p200)[[1]])
labeled_vinecop_plot(fitted_vines(uncond_risk_roll_20_21_g50_k25_p200)[[4]])
bicops_used(fitted_vines(uncond_risk_roll_20_21_g50_k25_p200)[[1]])##
## bb1 bb7 bb8 clayton frank gaussian gumbel indep
## 3 2 1 4 4 1 7 8
## joe t
## 3 3bicops_used(fitted_vines(uncond_risk_roll_20_21_g50_k25_p200)[[4]])##
## bb1 bb8 frank gaussian gumbel indep joe t
## 2 2 5 5 5 9 3 5It is obvious that in this high volatility time frame the use of copulas that stress tail dependence is much higher than in the previous time frame. Again the Banco Santander assets seems to have a central role in this portfolio.
Expected Shortfall estimators
As the package presents three different risk measure estimators namely the mean, median and monte carlo integration estimation it is reasonable to compare the estimated risk measures for the two time frames.
For the first time frame this looks as follows.
Also one might compare the number of exceedances.
risk_estimates(uncond_risk_roll_16_19_g50_k25_p250,
risk_measures = c("ES_mean", "ES_median", "ES_mc"),
alpha = 0.05,
exceeded = TRUE) %>%
group_by(risk_measure) %>%
summarise(relative_exceedances = mean(exceeded))Thus the differences in the estimation are minimal. Here actually we find an indication for the fact that the values that fell below the corresponding VaR where left skewed which leads to the fact that the mean will be a more conservative estimate in those cases which might explain the slightly lower exceedance rate. One can also look at the same comparisons for the second time frame.
Also one might compare the number of exceedances.
risk_estimates(uncond_risk_roll_20_21_g50_k25_p200,
risk_measures = c("ES_mean", "ES_median", "ES_mc"),
alpha = 0.05,
exceeded = TRUE) %>%
group_by(risk_measure) %>%
summarise(relative_exceedances = mean(exceeded))The same patterns as above are visible. Thus one will stick to the mean estimation approach in the rest of the analysis.
Backtesting the risk measures
Traditional Backtests
Now the first time frame 2016-19
get_traditional_backtests_uncond(
uncond_risk_roll_16_19_g50_k25_p250,
alphas = c(0.01, 0.025, 0.05)) %>%
bind_rows(
get_traditional_backtests_uncond(
uncond_risk_roll_16_19_g50_k50_p250,
alphas = c(0.01, 0.025, 0.05)
)
) %>%
bind_rows(
get_traditional_backtests_uncond(
uncond_risk_roll_16_19_g50_k25_p500,
alphas = c(0.01, 0.025, 0.05)
)
) %>%
bind_rows(
get_traditional_backtests_uncond(
uncond_risk_roll_16_19_g50_k50_p500,
alphas = c(0.01, 0.025, 0.05)
)
) %>%
mutate("vine training length" = rep(c(250, 500), each = 16),
"vine window size" = rep(rep(c(25, 50), each = 8), 2))All p-values are above the common confidence value 5% s.t. the
traditional backtests all pass. In some cases i.e. alpha level 0.01 due
to limitations of the esback package one has -1 as the
replacement when the backtest could not be performed. The closest
decisions were the unconditional coverage test at the alpha level 2.5%
with vine training length of 250 and window size 50 and the one sided
exceedance residual test at the level 5% with vine training length 500
and window size 50. Now display the results of the traditional backtests
for the second time frame.
get_traditional_backtests_uncond(
uncond_risk_roll_20_21_g50_k25_p100,
alphas = c(0.01, 0.025, 0.05)) %>%
bind_rows(
get_traditional_backtests_uncond(
uncond_risk_roll_20_21_g50_k25_p200,
alphas = c(0.01, 0.025, 0.05)
)
) %>%
bind_rows(
get_traditional_backtests_uncond(
uncond_risk_roll_20_21_g50_k50_p100,
alphas = c(0.01, 0.025, 0.05)
)
) %>%
bind_rows(
get_traditional_backtests_uncond(
uncond_risk_roll_20_21_g50_k50_p200,
alphas = c(0.01, 0.025, 0.05)
)
) %>%
mutate("vine training length" = rep(c(100, 200), each = 16),
"vine window size" = rep(rep(c(25, 50), each = 8), 2))Again looks good besides some too conservative estimates at the lowest alpha level where the one sided is highly significant and the two sided not. This means that one is probably too conservative in this case. Depending on the user of the backtest this might even be more desirable.
Visualize the unconditional risk measures
Visual comparison of the VaR and ES for one risk roll specification of the first time frame.
risk_estimates(uncond_risk_roll_16_19_g50_k25_p250,
risk_measures = c("ES_mean", "VaR"),
c(alpha = 0.01, 0.05)) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
mutate(
risk_measure = if_else(risk_measure == "ES_mean", "ES", risk_measure),
alpha = paste("alpha:", alpha)
) %>%
ggplot() +
geom_line(aes(x = date, y = realized), col = "grey") +
geom_line(aes(x = date, y = risk_est,
col = risk_measure, linetype = risk_measure),
size = 0.5) +
labs(x = "estimation window", y = "portfolio log returns",
linetype = "Risk measure",
subtitle = paste0("The realized portfolio log returns are given in ",
"<span style='color:",
"grey",
"'>**grey**</span>",
"."),
title = "Comparison of risk measure behavior") +
scale_color_manual(values = c(custom_colors[1], custom_colors[3]),
name = "Risk measure") +
facet_wrap(~alpha, labeller = label_parsed) +
theme(legend.position = "bottom")
As always now the second time frame.
risk_estimates(uncond_risk_roll_20_21_g50_k25_p100,
risk_measures = c("ES_mean", "VaR"),
c(alpha = 0.01, 0.05)) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num") %>%
mutate(
risk_measure = if_else(risk_measure == "ES_mean", "ES", risk_measure),
alpha = paste("alpha:", alpha)
) %>%
ggplot() +
geom_line(aes(x = date, y = realized), col = "grey") +
geom_line(aes(x = date, y = risk_est,
col = risk_measure, linetype = risk_measure),
size = 0.5) +
labs(x = "forecasting window (2021)", y = "portfolio log returns",
linetype = "Risk measure",
subtitle = paste0("The realized portfolio log returns are given in ",
"<span style='color:",
"grey",
"'>**grey**</span>",
"."),
title = "Comparison of risk measure behavior") +
scale_color_manual(values = c(custom_colors[1], custom_colors[3]),
name = "Risk measure") +
facet_wrap(~alpha, labeller = label_parsed) +
theme(legend.position = "bottom")
These plots also suggest empirically that the assumption of colinearity of the ES and VaR that is used in the ESR backtesting seems reasonable.
Now some exemplary exceedance plots.
# first time frame
risk_estimates(uncond_risk_roll_16_19_g50_k25_p250,
risk_measures = c("VaR"),
alpha = 0.025,
exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(aes(x = date, y = realized), col = "lightgrey") +
geom_line(aes(x = date, y = risk_est), col = custom_colors[3]) +
geom_point(aes(x = date, y = realized), col = custom_colors[2],
inherit.aes = FALSE, data = . %>% filter(exceeded)) +
labs(x = "estimation window",
y = "portfolio log returns",
col = "Exceeded",
subtitle = paste0(
"The realized portfolio log returns are given in ",
"<span style='color:",
"grey",
"'>**grey**</span>",
".<br>",
"Exceedances are highlighted in ",
"<span style='color:",
custom_colors[2],
"'>**red**</span>",
"."),
title = "Risk measure: VaR with alpha level 0.025"
) +
theme(legend.position = "none")
# second time frame
risk_estimates(uncond_risk_roll_20_21_g50_k25_p100,
risk_measures = c("VaR"),
alpha = 0.025,
exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(aes(x = date, y = realized), col = "lightgrey") +
geom_line(aes(x = date, y = risk_est), col = custom_colors[3]) +
geom_point(aes(x = date, y = realized), col = custom_colors[2],
inherit.aes = FALSE, data = . %>% filter(exceeded)) +
labs(x = "forecasting window (2021)",
y = "portfolio log returns",
col = "Exceeded",
subtitle = paste0(
"The realized portfolio log returns are given in ",
"<span style='color:",
"grey",
"'>**grey**</span>",
".<br>",
"Exceedances are highlighted in ",
"<span style='color:",
custom_colors[2],
"'>**red**</span>",
"."),
title = "Risk measure: VaR with alpha level 0.025"
) +
theme(legend.position = "none")
For the visualization of the ES it is reasonable to not mark the exceedances of the ES but again the ones of the corresponding VaR which is more natural given the definition of the ES. Examples are given below.
# first time frame
risk_estimates(uncond_risk_roll_16_19_g50_k25_p250,
risk_measures = c("ES_mean", "VaR"),
alpha = 0.025,
exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(aes(x = date, y = realized), col = "lightgrey",
data = . %>% filter(risk_measure == "VaR")) +
geom_line(aes(x = date, y = risk_est), col = custom_colors[1],
data = . %>% filter(risk_measure == "ES_mean")) +
geom_point(aes(x = date, y = realized), col = custom_colors[2],
inherit.aes = FALSE,
data = . %>% filter(exceeded & risk_measure == "VaR")) +
labs(x = "estimation window",
y = "portfolio log returns",
col = "Exceeded",
subtitle = paste0(
"The realized portfolio log returns are given in ",
"<span style='color:",
"grey",
"'>**grey**</span>",
".<br>",
"Exceedances of the VaR are highlighted in ",
"<span style='color:",
custom_colors[2],
"'>**red**</span>",
"."),
title = "Risk measure: ES with alpha level 0.025"
) +
theme(legend.position = "none")
# second time frame and final spec (for the FED talk)
risk_estimates(uncond_risk_roll_20_21_g50_k50_p200,
risk_measures = c("ES_mean", "VaR"),
alpha = 0.025,
exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(aes(x = date, y = realized), col = "lightgrey",
data = . %>% filter(risk_measure == "VaR")) +
geom_line(aes(x = date, y = risk_est), col = custom_colors[1],
data = . %>% filter(risk_measure == "ES_mean")) +
geom_point(aes(x = date, y = realized), col = custom_colors[2],
inherit.aes = FALSE,
data = . %>% filter(exceeded & risk_measure == "VaR")) +
labs(x = "forecasting window (2021)",
y = "portfolio log returns",
col = "Exceeded",
subtitle = paste0(
"The realized portfolio log returns are given in ",
"<span style='color:",
"grey",
"'>**grey**</span>",
".<br>",
"Exceedances of the VaR are highlighted in ",
"<span style='color:",
custom_colors[2],
"'>**red**</span>",
".",
"<br>Dependence model: R-vine"),
title = "Risk measure: ES with alpha level 0.025"
) +
theme(legend.position = "none")
# second time frame and D-vine based (for the FED talk)
risk_estimates(uncond_risk_roll_20_21_dvine,
risk_measures = c("ES_mean", "VaR"),
alpha = 0.025,
exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(aes(x = date, y = realized), col = "lightgrey",
data = . %>% filter(risk_measure == "VaR")) +
geom_line(aes(x = date, y = risk_est), col = custom_colors[1],
data = . %>% filter(risk_measure == "ES_mean")) +
geom_point(aes(x = date, y = realized), col = custom_colors[2],
inherit.aes = FALSE,
data = . %>% filter(exceeded & risk_measure == "VaR")) +
labs(x = "forecasting window (2021)",
y = "portfolio log returns",
col = "Exceeded",
subtitle = paste0(
"The realized portfolio log returns are given in ",
"<span style='color:",
"grey",
"'>**grey**</span>",
".<br>",
"Exceedances of the VaR are highlighted in ",
"<span style='color:",
custom_colors[2],
"'>**red**</span>",
".",
"<br>Dependence model: D-vine"),
title = "Risk measure: ES with alpha level 0.025"
) +
theme(legend.position = "none")
Comparative Backtests
The traditional backtests do not allow for a comparison thus one facilitates the comparative backtest by Nolde and Ziegel (2017) based on scoring functions in order to compare the models.
# the resulting matrix gives the following interpretation
# if the value is less than say nu = 5% then one would argue with the corresponding
# confidence of 95% that the model corresponding to the row performs at least
# as good as the one corresponding to the row. For values between nu and 1-nu
# one can not make a definitive decision but indications are yet visible.
# This three zone approach is the one of Nolde and Ziegel 2017
comparative_backtesting_matrix <- function(roll_list, alpha) {
n_rolls <- length(roll_list)
res <- matrix(rep(NA_real_, n_rolls^2), nrow = n_rolls)
for (i in seq(n_rolls)) {
for (j in seq(n_rolls)) {
if (i != j) {
res[i, j] <- es_comparative_backtest(
roll1 = roll_list[[i]],
roll2 = roll_list[[j]],
alpha = alpha
)[2]
}
}
}
colnames(res) <- names(roll_list)
rownames(res) <- names(roll_list)
res
}
cat("Alpha level 0.01\n")## Alpha level 0.01comparative_backtesting_matrix(
list(
k25_p250 = uncond_risk_roll_16_19_g50_k25_p250,
k25_p500 = uncond_risk_roll_16_19_g50_k25_p500,
k50_p250 = uncond_risk_roll_16_19_g50_k50_p250,
k50_p500 = uncond_risk_roll_16_19_g50_k50_p500
),
alpha = 0.01
)## k25_p250 k25_p500 k50_p250 k50_p500
## k25_p250 NA 0.8127362 0.7170077 0.8455523
## k25_p500 0.1872638 NA 0.2756982 0.5676594
## k50_p250 0.2829923 0.7243018 NA 0.7648079
## k50_p500 0.1544477 0.4323406 0.2351921 NAcat("Alpha level 0.05\n")## Alpha level 0.05comparative_backtesting_matrix(
list(
k25_p250 = uncond_risk_roll_16_19_g50_k25_p250,
k25_p500 = uncond_risk_roll_16_19_g50_k25_p500,
k50_p250 = uncond_risk_roll_16_19_g50_k50_p250,
k50_p500 = uncond_risk_roll_16_19_g50_k50_p500
),
alpha = 0.05
)## k25_p250 k25_p500 k50_p250 k50_p500
## k25_p250 NA 0.6956983 0.6545721 0.6657343
## k25_p500 0.3043017 NA 0.3420546 0.3670459
## k50_p250 0.3454279 0.6579454 NA 0.6226795
## k50_p500 0.3342657 0.6329541 0.3773205 NAAgain one first has a look at the first time frame. Here no definite decisions are possible. The results however provide some indications. For example the longer vine training window size of 500 seems to be slightly better than the shorter training window size. Moreover the smaller vine window of 25 does not seem to be necessary. The window size of 50 might even be in cases superior. So overall from the indications one would probably opt for the model with vine training size of 500 and refit size 50.
In this setting one has also estimated the risk measures with only Gaussian and Student’s t components (now referred to as a t-vine). Thus a comparison would be very interesting.
cat("Alpha level 0.01\n")## Alpha level 0.01comparative_backtesting_matrix(
list(
all = uncond_risk_roll_16_19_g50_k50_p250,
gaussian_t = uncond_risk_roll_16_19_t,
gauss = uncond_risk_roll_16_19_gauss
),
alpha = 0.01
)## all gaussian_t gauss
## all NA 0.7001880 0.5801082
## gaussian_t 0.2998120 NA 0.1879733
## gauss 0.4198918 0.8120267 NAcat("Alpha level 0.05\n")## Alpha level 0.05comparative_backtesting_matrix(
list(
all = uncond_risk_roll_16_19_g50_k50_p250,
gaussian_t = uncond_risk_roll_16_19_t,
gauss = uncond_risk_roll_16_19_gauss
),
alpha = 0.05
)## all gaussian_t gauss
## all NA 0.8159698 0.6848087
## gaussian_t 0.1840302 NA 0.1153934
## gauss 0.3151913 0.8846066 NAThere is a slight tendency towards the t-vine model. One can have a look at the respective risk measures visually.
(
risk_estimates(uncond_risk_roll_16_19_g50_k50_p250,
risk_measures = c("ES_mean", "VaR"),
alpha = 0.05,
exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(aes(x = date, y = realized), col = "lightgrey",
data = . %>% filter(risk_measure == "VaR")) +
geom_line(aes(x = date, y = risk_est), col = custom_colors[1],
data = . %>% filter(risk_measure == "ES_mean")) +
geom_point(aes(x = date, y = realized), col = custom_colors[2],
inherit.aes = FALSE,
data = . %>% filter(exceeded & risk_measure == "VaR")) +
labs(x = "estimation window",
y = "portfolio log returns",
col = "Exceeded",
subtitle = paste0("Exceedances of the VaR are highlighted in ",
"<span style='color:",
custom_colors[2],
"'>**red**</span>",
"."),
title = "Risk measure: ES with alpha level 0.05, all parametric copula families"
) +
theme(legend.position = "none")
) / (
risk_estimates(uncond_risk_roll_16_19_t,
risk_measures = c("ES_mean", "VaR"),
alpha = 0.05,
exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(aes(x = date, y = realized), col = "lightgrey",
data = . %>% filter(risk_measure == "VaR")) +
geom_line(aes(x = date, y = risk_est), col = custom_colors[1],
data = . %>% filter(risk_measure == "ES_mean")) +
geom_point(aes(x = date, y = realized), col = custom_colors[2],
inherit.aes = FALSE,
data = . %>% filter(exceeded & risk_measure == "VaR")) +
labs(x = "estimation window",
y = "portfolio log returns",
col = "Exceeded",
subtitle = paste0("Exceedances of the VaR are highlighted in ",
"<span style='color:",
custom_colors[2],
"'>**red**</span>",
"."),
title = "Risk measure: ES with alpha level 0.05, only Gaussian and Student's t copulas"
) +
theme(legend.position = "none")
)
The difference is also visually quite small. One can just see a slightly more conservative risk measure for the t-vine model.
Next up the second time frame.
comparative_backtesting_matrix(
list(
k25_p100 = uncond_risk_roll_20_21_g50_k25_p100,
k25_p200 = uncond_risk_roll_20_21_g50_k25_p200,
k50_p100 = uncond_risk_roll_20_21_g50_k50_p100,
k50_p200 = uncond_risk_roll_20_21_g50_k50_p200
),
alpha = 0.01
)## k25_p100 k25_p200 k50_p100 k50_p200
## k25_p100 NA 0.6759593 0.06856834 0.7091422
## k25_p200 0.3240407 NA 0.19989276 0.7861632
## k50_p100 0.9314317 0.8001072 NA 0.7983376
## k50_p200 0.2908578 0.2138368 0.20166243 NAcomparative_backtesting_matrix(
list(
k25_p100 = uncond_risk_roll_20_21_g50_k25_p100,
k25_p200 = uncond_risk_roll_20_21_g50_k25_p200,
k50_p100 = uncond_risk_roll_20_21_g50_k50_p100,
k50_p200 = uncond_risk_roll_20_21_g50_k50_p200
),
alpha = 0.05
)## k25_p100 k25_p200 k50_p100 k50_p200
## k25_p100 NA 0.82603878 0.09809045 0.8453722
## k25_p200 0.1739612 NA 0.11532104 0.9068706
## k50_p100 0.9019095 0.88467896 NA 0.8898365
## k50_p200 0.1546278 0.09312937 0.11016347 NAHere as above a tendency towards the bigger vine training window size is visible. No definitive answer can be given however. There is no clear indication whether the shorter or bigger vine rolling window of 25 or 50 performs better. From these indications one would probably opt for the model with vine training size 200 and refit size 50.
Again for the comparison a t-vine model was fitted.
comparative_backtesting_matrix(
list(
all = uncond_risk_roll_20_21_g50_k50_p200,
gaussian_t = uncond_risk_roll_20_21_t,
gauss = uncond_risk_roll_20_21_gauss
),
alpha = 0.01
)## all gaussian_t gauss
## all NA 0.3902836 0.4443668
## gaussian_t 0.6097164 NA 0.6114113
## gauss 0.5556332 0.3885887 NAcomparative_backtesting_matrix(
list(
all = uncond_risk_roll_20_21_g50_k50_p200,
gaussian_t = uncond_risk_roll_20_21_t,
gauss = uncond_risk_roll_20_21_gauss
),
alpha = 0.05
)## all gaussian_t gauss
## all NA 0.1004527 0.09995144
## gaussian_t 0.8995473 NA 0.70782042
## gauss 0.9000486 0.2921796 NAContrary to the setting in the first time frame one can observe that here there is a clear indication visible that the general R-vine model does perform better. The decision is however not definitive. Once again a visual inspection is reasonable.
(
risk_estimates(uncond_risk_roll_20_21_g50_k50_p200,
risk_measures = c("ES_mean", "VaR"),
alpha = 0.05,
exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(aes(x = date, y = realized), col = "lightgrey",
data = . %>% filter(risk_measure == "VaR")) +
geom_line(aes(x = date, y = risk_est), col = custom_colors[1],
data = . %>% filter(risk_measure == "ES_mean")) +
geom_point(aes(x = date, y = realized), col = custom_colors[2],
inherit.aes = FALSE,
data = . %>% filter(exceeded & risk_measure == "VaR")) +
labs(x = "forecasting window (2021)",
y = "portfolio log returns",
col = "Exceeded",
subtitle = paste0("Exceedances of the VaR are highlighted in ",
"<span style='color:",
custom_colors[2],
"'>**red**</span>",
"."),
title = "Risk measure: ES with alpha level 0.05, all parametric copula families"
) +
theme(legend.position = "none")
) / (
risk_estimates(uncond_risk_roll_20_21_t,
risk_measures = c("ES_mean", "VaR"),
alpha = 0.05,
exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(aes(x = date, y = realized), col = "lightgrey",
data = . %>% filter(risk_measure == "VaR")) +
geom_line(aes(x = date, y = risk_est), col = custom_colors[1],
data = . %>% filter(risk_measure == "ES_mean")) +
geom_point(aes(x = date, y = realized), col = custom_colors[2],
inherit.aes = FALSE,
data = . %>% filter(exceeded & risk_measure == "VaR")) +
labs(x = "forecasting window (2021)",
y = "portfolio log returns",
col = "Exceeded",
subtitle = paste0("Exceedances of the VaR are highlighted in ",
"<span style='color:",
custom_colors[2],
"'>**red**</span>",
"."),
title = "Risk measure: ES with alpha level 0.05, only Gaussian and Student's t copulas"
) +
theme(legend.position = "none")
)
The only considerable difference is that the risk estimates corresponding to the R-vine model are slightly more conservative which might be desirable in a high volatility situation like the ongoing pandemic in 2021.
All in all one can conclude that in both time frames the unconditional risk measure estimation approach worked really well as on all tested confidence levels all traditional backtests passed.
Single conditional risk measure estimation
Here one uses the same base portfolio as in the unconditional case but introduces a conditioning variable. One will have a look at the influence of two conditioning market indices namely the SP500 and the Eurostoxx50 indices. They represent the overall American and European market trend.
# load the single conditional models
load(here::here("data", "msci_spain_cond1_1619euro.RData"))
load(here::here("data", "msci_spain_cond1_1619sp500.RData"))
load(here::here("data", "msci_spain_cond1_1619euro_prior_resid.RData"))
load(here::here("data", "msci_spain_cond1_1619sp500_prior_resid.RData"))
load(here::here("data", "msci_spain_cond1_2021.RData"))Look at the fitted models for the first time frame.
summary(cond_risk_roll_16_19_sp500)## An object of class <cond_portvine_roll>
##
## --- Conditional settings ---
## Conditional variable(s): sp500
## Number of conditional estimated risk measures: 20440
## Conditioning quantiles: 0.05 0.1 0.25 0.5
##
## --- Marginal models ---
## Number of ARMA-GARCH/ marginal windows: 6
## Train size: 750
## Refit size: 50
##
## --- Vine copula models ---
## Number of vine windows: 6
## Train size: 500
## Refit size: 50
## Vine copula type: dvine
## Vine family set: parametric
##
## --- Risk estimation ---
## Risk measures estimated: VaR ES_mean
## Alpha levels used: 0.01 0.025 0.05 0.25 0.5 0.75 0.95
## Number of estimated risk measures: 4088
## Number of samples for each risk estimation: 1e+05
##
## Time taken: 232.6377 minutes.summary(cond_risk_roll_16_19_eurostoxx50)## An object of class <cond_portvine_roll>
##
## --- Conditional settings ---
## Conditional variable(s): eurostoxx50
## Number of conditional estimated risk measures: 20440
## Conditioning quantiles: 0.05 0.1 0.25 0.5
##
## --- Marginal models ---
## Number of ARMA-GARCH/ marginal windows: 6
## Train size: 750
## Refit size: 50
##
## --- Vine copula models ---
## Number of vine windows: 6
## Train size: 500
## Refit size: 50
## Vine copula type: dvine
## Vine family set: parametric
##
## --- Risk estimation ---
## Risk measures estimated: VaR ES_mean
## Alpha levels used: 0.01 0.025 0.05 0.25 0.5 0.75 0.95
## Number of estimated risk measures: 4088
## Number of samples for each risk estimation: 1e+05
##
## Time taken: 272.0227 minutes.And the second time frame.
summary(cond_risk_roll_20_21_sp500)## An object of class <cond_portvine_roll>
##
## --- Conditional settings ---
## Conditional variable(s): sp500
## Number of conditional estimated risk measures: 7000
## Conditioning quantiles: 0.05 0.1 0.25 0.5
##
## --- Marginal models ---
## Number of ARMA-GARCH/ marginal windows: 2
## Train size: 300
## Refit size: 50
##
## --- Vine copula models ---
## Number of vine windows: 2
## Train size: 200
## Refit size: 50
## Vine copula type: dvine
## Vine family set: parametric
##
## --- Risk estimation ---
## Risk measures estimated: VaR ES_mean
## Alpha levels used: 0.01 0.025 0.05 0.25 0.5 0.75 0.95
## Number of estimated risk measures: 1400
## Number of samples for each risk estimation: 1e+05
##
## Time taken: 59.9842 minutes.summary(cond_risk_roll_20_21_eurostoxx50)## An object of class <cond_portvine_roll>
##
## --- Conditional settings ---
## Conditional variable(s): eurostoxx50
## Number of conditional estimated risk measures: 7000
## Conditioning quantiles: 0.05 0.1 0.25 0.5
##
## --- Marginal models ---
## Number of ARMA-GARCH/ marginal windows: 2
## Train size: 300
## Refit size: 50
##
## --- Vine copula models ---
## Number of vine windows: 2
## Train size: 200
## Refit size: 50
## Vine copula type: dvine
## Vine family set: parametric
##
## --- Risk estimation ---
## Risk measures estimated: VaR ES_mean
## Alpha levels used: 0.01 0.025 0.05 0.25 0.5 0.75 0.95
## Number of estimated risk measures: 1400
## Number of samples for each risk estimation: 1e+05
##
## Time taken: 65.2145 minutes.Assessment of the marginal models
Here actually one only has to check whether the index is well fitted. The marginal models for the portfolio do not change.
marg_viz_cond_risk_roll_16_19sp500 <- marg_resid_viz_list(
cond_risk_roll_16_19_sp500
)
marg_viz2_cond_risk_roll_16_19sp500 <- marg_resid_viz_list(
cond_risk_roll_16_19_sp500, squared = TRUE
)
marg_viz_cond_risk_roll_16_19euro <- marg_resid_viz_list(
cond_risk_roll_16_19_eurostoxx50
)
marg_viz2_cond_risk_roll_16_19euro <- marg_resid_viz_list(
cond_risk_roll_16_19_eurostoxx50, squared = TRUE
)
marg_viz_cond_risk_roll_20_21sp500 <- marg_resid_viz_list(
cond_risk_roll_20_21_sp500
)
marg_viz2_cond_risk_roll_20_21sp500 <- marg_resid_viz_list(
cond_risk_roll_20_21_sp500, squared = TRUE
)
marg_viz_cond_risk_roll_20_21euro <- marg_resid_viz_list(
cond_risk_roll_20_21_eurostoxx50
)
marg_viz2_cond_risk_roll_20_21euro <- marg_resid_viz_list(
cond_risk_roll_20_21_eurostoxx50, squared = TRUE
)The residual analysis for the conditional variables regarding the first time frame suggest a good fit of the ARMA(1,1)-GARCH(1,1) model as evident below.
marg_viz_cond_risk_roll_16_19sp500$sp500
marg_viz2_cond_risk_roll_16_19sp500$sp500
marg_viz_cond_risk_roll_16_19euro$eurostoxx50
marg_viz2_cond_risk_roll_16_19euro$eurostoxx50
For the second time frame one can observe a very close call for the mean equation of the marginal model for the conditional variable SP500. As the decision is very close one will not adjust the model in this case and stick to the default ARMA(1,1)-GARCH(1,1) model.
marg_viz_cond_risk_roll_20_21sp500$sp500
marg_viz2_cond_risk_roll_20_21sp500$sp500
marg_viz_cond_risk_roll_20_21euro$eurostoxx50
marg_viz2_cond_risk_roll_20_21euro$eurostoxx50
A look at the D-vines
Here one uses D-vines with the fixed position of the index at the rightmost leaf. One can have a look whether the ordering changes over time and which asset seems to be most influenced by the market index. Again also the fitted bivariate copulas are of interest.
One starts with the first time frame and the SP500 index.
labeled_vinecop_plot(fitted_vines(cond_risk_roll_16_19_sp500)[[1]])
labeled_vinecop_plot(fitted_vines(cond_risk_roll_16_19_sp500)[[3]])
labeled_vinecop_plot(fitted_vines(cond_risk_roll_16_19_sp500)[[6]])
bicops_used(fitted_vines(cond_risk_roll_16_19_sp500)[[1]])##
## bb1 bb8 clayton frank gaussian gumbel indep joe
## 2 4 4 11 2 2 6 6
## t
## 8bicops_used(fitted_vines(cond_risk_roll_16_19_sp500)[[3]])##
## bb1 bb8 clayton frank gaussian gumbel indep joe
## 2 3 3 11 4 1 9 3
## t
## 9bicops_used(fitted_vines(cond_risk_roll_16_19_sp500)[[6]])##
## bb1 bb8 clayton frank gaussian gumbel indep t
## 3 3 5 9 3 4 11 7index_copulas(fitted_vines(cond_risk_roll_16_19_sp500)[[1]])index_copulas(fitted_vines(cond_risk_roll_16_19_sp500)[[6]])The ordering changes quite strongly and quite notably the pairwise dependence in terms of the Kendall’s tau is really weak with the index and the second rightmost asset. Next up one will have a look at the Eurostoxx50 index.
labeled_vinecop_plot(fitted_vines(cond_risk_roll_16_19_eurostoxx50)[[1]])
labeled_vinecop_plot(fitted_vines(cond_risk_roll_16_19_eurostoxx50)[[3]])
labeled_vinecop_plot(fitted_vines(cond_risk_roll_16_19_eurostoxx50)[[6]])
bicops_used(fitted_vines(cond_risk_roll_16_19_eurostoxx50)[[1]])##
## bb1 bb8 clayton frank gaussian gumbel indep joe
## 1 6 3 9 4 5 5 2
## t
## 10bicops_used(fitted_vines(cond_risk_roll_16_19_eurostoxx50)[[3]])##
## bb1 bb7 bb8 clayton frank gaussian gumbel indep
## 3 1 2 1 14 4 5 6
## joe t
## 1 8bicops_used(fitted_vines(cond_risk_roll_16_19_eurostoxx50)[[6]])##
## bb1 bb8 clayton frank gaussian gumbel indep joe
## 5 3 1 11 3 8 7 2
## t
## 5index_copulas(fitted_vines(cond_risk_roll_16_19_eurostoxx50)[[1]])index_copulas(fitted_vines(cond_risk_roll_16_19_eurostoxx50)[[6]])Notably and also like expected the pairwise dependence of the index with the second rightmost asset (Banco Santander) is much stronger. The dependence is also much more anticipated as for example Banco Santander, the Amadeus IT Group, Iberdrola and Inditex are included in the index but only with a cumulative weight of roughly 5%. Thus in a stress testing situation one would expect the conditioning on the Eurostoxx50 index to be much more influential. The same analysis is now performed on the second time frame.
labeled_vinecop_plot(fitted_vines(cond_risk_roll_20_21_sp500)[[1]])
labeled_vinecop_plot(fitted_vines(cond_risk_roll_20_21_sp500)[[2]])
bicops_used(fitted_vines(cond_risk_roll_20_21_sp500)[[1]])##
## bb1 bb7 bb8 clayton frank gaussian gumbel indep
## 3 3 1 5 6 2 2 12
## joe t
## 7 4bicops_used(fitted_vines(cond_risk_roll_20_21_sp500)[[2]])##
## bb1 bb7 bb8 clayton frank gaussian gumbel indep
## 2 3 1 2 7 5 4 10
## joe t
## 6 5index_copulas(fitted_vines(cond_risk_roll_20_21_sp500)[[1]])As in the unconditional case one can detect more copulas that stress tail dependence and notably Iberdrola and Inditex are both quite stable in the ordering. Now the Eurostoxx50 index.
labeled_vinecop_plot(fitted_vines(cond_risk_roll_20_21_eurostoxx50)[[1]])
labeled_vinecop_plot(fitted_vines(cond_risk_roll_20_21_eurostoxx50)[[2]])
bicops_used(fitted_vines(cond_risk_roll_20_21_eurostoxx50)[[1]])##
## bb1 bb7 clayton frank gaussian gumbel indep joe
## 1 5 2 11 5 6 6 5
## t
## 4bicops_used(fitted_vines(cond_risk_roll_20_21_eurostoxx50)[[2]])##
## bb1 bb7 bb8 clayton frank gaussian gumbel indep
## 2 4 1 5 6 5 6 7
## joe t
## 4 5index_copulas(fitted_vines(cond_risk_roll_20_21_eurostoxx50)[[1]])The heavy usage of copulas that stress tail dependence especially in the first tree level is directly evident. Now Inditex and the Amadeus IT Group, both constituents of the index, show strong dependencies with the index.
Behavior of the conditioning value
As one now conditions the risk measure estimation on each day on a
conditioning value from the conditioning variable it is reasonable to
first look at the different conditioning values that were estimated.
Here one differentiates between the conditioning values based on
quantiles and the ones based on the residual of the day before
(prior_resid) and the realized residuals
(resid). One starts again with the first time frame and the
conditioning on the SP500.
risk_estimates(cond_risk_roll_16_19_sp500, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.05, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = sp500.y), col = "#828282", size = .6) +
geom_line(aes(x = date, y = sp500.x, col = fct_rev(factor(cond_u))),
size = 0.5) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based **conditioning values** of the SP500",
col = "Quantile level",
x = "estimation window", y = "log returns of the SP500",
subtitle = paste0("The realized log returns of the SP500 are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
"."))
This is exactly the anticipated behavior. Using a small quantile level \(\alpha^I\) like 0.1 resembles a really bad situation in the American market. The conditional values based on the prior residuals closely mitigate/ forecast the true behavior of the conditional asset as can be seen below. A slight delay and some exaggerations are clearly visible.
risk_estimates(cond_risk_roll_16_19_sp500_prior_resid, risk_measures = "ES_mean",
cond_u = "prior_resid",
alpha = 0.05, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = sp500.y), col = "black", size = .6, alpha = 0.5) +
geom_line(aes(x = date, y = sp500.x),
size = 0.5, col = custom_colors[4]) +
labs(title = "Conditional variable: SP500", col = "Quantile level",
x = "estimation window", y = "log returns of the SP500",
subtitle = paste0("The conditional values corresponding to the residual
of the prior day are drawn in ",
"<span style='color:",
custom_colors[4],
"'>**violet**</span>",
".",
"<br>The realized log returns of the SP500 are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".")) +
theme_light() +
ggforce::facet_zoom(x = date >= as.Date("2019-03-01") & date <= as.Date("2019-04-01")) +
theme(panel.border = element_blank(),
plot.subtitle = ggtext::element_markdown(size = 9))
As expected the realized residual strategy does exactly correspond to the true conditioning value and thus is only for comparative purposues as the conditional risk measures are oracle estimators.
risk_estimates(cond_risk_roll_16_19_sp500, risk_measures = "ES_mean",
cond_u = "resid",
alpha = 0.05, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = sp500.y), col = "black", size = .6, alpha = 0.5) +
geom_line(aes(x = date, y = sp500.x),
size = 0.5, col = "#37d925") +
labs(title = "Conditional variable: SP500", col = "Quantile level",
x = "estimation window", y = "log returns of the SP500",
subtitle = paste0("The conditional values corresponding to the realized
residual are drawn in ",
"<span style='color:",
"#37d925",
"'>**green**</span>",
".",
"<br>The realized log returns of the SP500 are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".")) +
theme_light() +
ggforce::facet_zoom(x = date >= as.Date("2019-03-01") & date <= as.Date("2019-04-01")) +
theme(panel.border = element_blank(),
plot.subtitle = ggtext::element_markdown(size = 9))
Now the Eurostoxx50 index for the first time frame.
risk_estimates(cond_risk_roll_16_19_eurostoxx50, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.05, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = eurostoxx50.y), col = "#828282", size = .6) +
geom_line(aes(x = date, y = eurostoxx50.x, col = fct_rev(factor(cond_u))),
size = 0.5) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based **conditioning values** of the Eurostoxx 50",
col = "Quantile level",
x = "estimation window", y = "log returns of the Eurostoxx 50",
subtitle = paste0("The realized log returns of the Eurostoxx 50
are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
"."))
The same pattern as for the other conditional asset is visible. The index however seems to have more extreme market situations.
risk_estimates(cond_risk_roll_16_19_eurostoxx50_prior_resid,
risk_measures = "ES_mean",
cond_u = "prior_resid",
alpha = 0.05, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = eurostoxx50.y), col = "black", size = .6, alpha = 0.5) +
geom_line(aes(x = date, y = eurostoxx50.x),
size = 0.5, col = custom_colors[4]) +
labs(title = "Conditional variable: Eurostoxx 50", col = "Quantile level",
x = "estimation window", y = "log returns of the Eurostoxx 50",
subtitle = paste0("The conditional values corresponding to the residual
of the prior day are drawn in ",
"<span style='color:",
custom_colors[4],
"'>**violet**</span>",
".",
"<br>The realized log returns of the Eurostoxx 50
are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".")) +
theme_light() +
ggforce::facet_zoom(x = date >= as.Date("2019-03-01") & date <= as.Date("2019-04-01")) +
theme(panel.border = element_blank(),
plot.subtitle = ggtext::element_markdown(size = 9))
Again the same pattern as for the SP500 is visible. The realized residual strategy is not of particular interest to visualize. One now presents these visualizations also for the second time frame.
risk_estimates(cond_risk_roll_20_21_sp500, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.05, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = sp500.y), col = "#828282", size = .6) +
geom_line(aes(x = date, y = sp500.x, col = fct_rev(factor(cond_u))),
size = 0.5) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based **conditioning values** of the SP500",
col = "Quantile level",
x = "forecasting window (2021)", y = "log returns of the SP500",
subtitle = paste0("The realized log returns of the SP500 are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
"."))
risk_estimates(cond_risk_roll_20_21_eurostoxx50, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.05, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = eurostoxx50.y), col = "#828282", size = .6) +
geom_line(aes(x = date, y = eurostoxx50.x, col = fct_rev(factor(cond_u))),
size = 0.5) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based **conditioning values** of the Eurostoxx 50",
col = "Quantile level",
x = "forecasting window (2021)", y = "log returns of the Eurostoxx 50",
subtitle = paste0("The realized log returns of the Eurostoxx 50 are
given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
"."))
Again the same patterns as before are visible.
The conditional risk measure estimates
Now it is of course interesting to visualize not only the conditional values but the actual conditional risk measures. One will thereby focus on the Expected Shortfall at the level 2.5%.
As before one starts with the first time frame and the conditioning on the SP500 index.
# raw
risk_estimates(cond_risk_roll_16_19_sp500, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "estimation window", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: SP500",
"<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
"."))
# realized residuals
risk_estimates(cond_risk_roll_16_19_sp500, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
cond_risk_roll_16_19_sp500,
risk_measures = "ES_mean",
cond_u = c("resid"),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num"),
col = "#37d925"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "estimation window", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: SP500<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>",
"The
ES estimates conditioned on the **realized residuals** are drawn in
<span style='color:#37d925'>**green**</span>."
))
# dvine based
risk_estimates(cond_risk_roll_16_19_sp500, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
uncond_risk_roll_16_19_dvine,
risk_measures = "ES_mean",
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num"),
col = "#fca103"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "estimation window", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: SP500<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>",
"The
unconditional D-vine based ES estimates are drawn in
<span style='color:#fca103'>**orange**</span>."))
# rvine based
risk_estimates(cond_risk_roll_16_19_sp500, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
uncond_risk_roll_16_19_g50_k50_p500,
risk_measures = "ES_mean",
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num"),
col = "#e6db00"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "estimation window", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: SP500<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>", "The
unconditional R-vine based ES estimates are drawn in
<span style='color:#e6db00'>**gold**</span>."))
As expected the risk measures seems to be very robust to changes in the American market. This is most likely a consequence of the very small dependency modeled in the D-vine.
Now the risk measures based on the prior residuals.
risk_estimates(cond_risk_roll_16_19_sp500_prior_resid,
risk_measures = "ES_mean",
cond_u = "prior_resid",
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est),
size = 0.5, col = custom_colors[4]) +
labs(title = "Prior residual based conditional Expected Shortfall",
col = "Quantile level",
x = "estimation window", y = "portfolio log returns",
subtitle = paste0("The conditional
Expected Shortfall at level 2.5% is drawn in ",
"<span style='color:",
custom_colors[4],
"'>**violet**</span>",
".<br>Conditional variable: SP500",
"<br>The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
"."))
Next up is the much more influential market index Eurostoxx 50.
# raw
risk_estimates(cond_risk_roll_16_19_eurostoxx50, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "estimation window", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: Eurostoxx 50",
"<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
"."))
# realized residuals
risk_estimates(cond_risk_roll_16_19_eurostoxx50, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
cond_risk_roll_16_19_eurostoxx50,
risk_measures = "ES_mean",
cond_u = c("resid"),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num"),
col = "#37d925"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "estimation window", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: Eurostoxx 50<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>",
"The
ES estimates conditioned on the **realized residuals** are drawn in
<span style='color:#37d925'>**green**</span>."
))
# dvine based
risk_estimates(cond_risk_roll_16_19_eurostoxx50, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
uncond_risk_roll_16_19_dvine,
risk_measures = "ES_mean",
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num"),
col = "#fca103"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "estimation window", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: Eurostoxx 50<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>",
"The
unconditional D-vine based ES estimates are drawn in
<span style='color:#fca103'>**orange**</span>."))
# rvine based
risk_estimates(cond_risk_roll_16_19_eurostoxx50, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
uncond_risk_roll_16_19_g50_k50_p500,
risk_measures = "ES_mean",
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num"),
col = "#e6db00"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "estimation window", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: Eurostoxx 50<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>", "The
unconditional R-vine based ES estimates are drawn in
<span style='color:#e6db00'>**gold**</span>."))
Here contrary to the case before one can detect a strong influence of the conditional quantile level on the final risk measures. This means that one has to cover the case of a bad European market situation in stress testing scenarios.
Now the risk measures based on the prior residuals.
risk_estimates(cond_risk_roll_16_19_eurostoxx50_prior_resid,
risk_measures = "ES_mean",
cond_u = "prior_resid",
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est),
size = 0.5, col = custom_colors[4]) +
labs(title = "Prior residual based conditional Expected Shortfall",
col = "Quantile level",
x = "estimation window", y = "portfolio log returns",
subtitle = paste0("The conditional
Expected Shortfall at level 2.5% is drawn in ",
"<span style='color:",
custom_colors[4],
"'>**violet**</span>",
".<br>Conditional variable: Eurostoxx 50",
"<br>The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
"."))
At the first glance this additional conditional variable seems to be
very close to the actual realized portfolio returns which might be
highly desirable. Yet a look at the traditional backtests might uncover
that the risk measures are too close to the realized returns. Moreover
in this setting a comparative backtest is not fair as the
prior_resid strategy uses for the simulation the data from
the prior day while the unconditional model does only use forecasted
quantities for a whole marginal window.
get_traditional_backtests_cond(cond_risk_roll_16_19_eurostoxx50_prior_resid,
c(0.01, 0.025, 0.05), "prior_resid") %>%
mutate(across(starts_with("alpha"), round, digits = 4))# compare with the oracle risk estimates that are based on the realized residuals
get_traditional_backtests_cond(cond_risk_roll_16_19_eurostoxx50,
c(0.01, 0.025, 0.05), "resid") %>%
mutate(across(starts_with("alpha"), round, digits = 4))As expected from the plot the risk measures are not at all conservative enough and thus fail all traditional backtests. The oracle risk estimates based on the realized residuals do almost pass all traditional backtest although they are much less robust than the quantile based ones. This is however not surprising giving that they use future information during estimation.
Next one has a look at the second time frame. The conditional index SP500 is again the first one to be analysed.
# raw
risk_estimates(cond_risk_roll_20_21_sp500, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "forecasting window (2021)", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: SP500",
"<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
"."))
# realized residuals
risk_estimates(cond_risk_roll_20_21_sp500, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
cond_risk_roll_20_21_sp500,
risk_measures = "ES_mean",
cond_u = c("resid"),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num"),
col = "#37d925"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "forecasting window (2021)", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: SP500<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>",
"The
ES estimates conditioned on the **realized residuals** are drawn in
<span style='color:#37d925'>**green**</span>."
))
# dvine based
risk_estimates(cond_risk_roll_20_21_sp500, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
uncond_risk_roll_20_21_dvine,
risk_measures = "ES_mean",
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num"),
col = "#fca103"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "forecasting window (2021)", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: SP500<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>",
"The
unconditional D-vine based ES estimates are drawn in
<span style='color:#fca103'>**orange**</span>."))
# rvine based
risk_estimates(cond_risk_roll_20_21_sp500, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
uncond_risk_roll_20_21_g50_k50_p200,
risk_measures = "ES_mean",
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num"),
col = "#e6db00"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "forecasting window (2021)", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: SP500<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>", "The
unconditional R-vine based ES estimates are drawn in
<span style='color:#e6db00'>**gold**</span>."))
Again here probably due to the low influence of the SP500 the risk measure is quite similar to the unconditional one.
# raw
risk_estimates(cond_risk_roll_20_21_eurostoxx50, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "forecasting window (2021)", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: Eurostoxx 50",
"<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
"."))
# realized residuals
risk_estimates(cond_risk_roll_20_21_eurostoxx50, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
cond_risk_roll_20_21_eurostoxx50,
risk_measures = "ES_mean",
cond_u = c("resid"),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num"),
col = "#37d925"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "forecasting window (2021)", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: Eurostoxx 50<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>",
"The
ES estimates conditioned on the **realized residuals** are drawn in
<span style='color:#37d925'>**green**</span>."
))
# dvine based
risk_estimates(cond_risk_roll_20_21_eurostoxx50, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
uncond_risk_roll_20_21_dvine,
risk_measures = "ES_mean",
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num"),
col = "#fca103"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "forecasting window (2021)", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: Eurostoxx 50<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>",
"The
unconditional D-vine based ES estimates are drawn in
<span style='color:#fca103'>**orange**</span>."))
# rvine based
risk_estimates(cond_risk_roll_20_21_eurostoxx50, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
uncond_risk_roll_20_21_g50_k50_p200,
risk_measures = "ES_mean",
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num"),
col = "#e6db00"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "forecasting window (2021)", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variable: Eurostoxx 50<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>", "The
unconditional R-vine based ES estimates are drawn in
<span style='color:#e6db00'>**gold**</span>."))
All in all the strategy based on the quantiles is much more promising. As further research one could try to truncate the prior day residuals for example with the function \(f(z) = max(0,z)\). But this could of course lead to too conservative estimates.
Double conditional risk measure estimation
For the double conditional case one sticks to the given portfolio and now not considers both the SP500 and the Eurostoxx50 as the conditional assets because this would boil down to basically the single conditional case as the SP500 has no serious influence. For this reason one will use the given its market capitalization biggest asset of the portfolio as the second conditional asset besides the Eurostoxx 50 index. This is Iberdrola. Thus one does not need to further check the marginal models. A look at the fitted D-vines is however advisable.
# load the double conditional models
load(here::here("data", "msci_spain_cond2_res16.RData"))
load(here::here("data", "msci_spain_cond2_res20.RData"))First a look at the model summaries.
summary(cond2_risk_roll_16_19)## An object of class <cond_portvine_roll>
##
## --- Conditional settings ---
## Conditional variable(s): eurostoxx50 iberdrola
## Number of conditional estimated risk measures: 20440
## Conditioning quantiles: 0.05 0.1 0.25 0.5
##
## --- Marginal models ---
## Number of ARMA-GARCH/ marginal windows: 6
## Train size: 750
## Refit size: 50
##
## --- Vine copula models ---
## Number of vine windows: 6
## Train size: 500
## Refit size: 50
## Vine copula type: dvine
## Vine family set: parametric
##
## --- Risk estimation ---
## Risk measures estimated: VaR ES_mean
## Alpha levels used: 0.01 0.025 0.05 0.25 0.5 0.75 0.95
## Number of estimated risk measures: 4088
## Number of samples for each risk estimation: 1e+05
##
## Time taken: 258.8239 minutes.summary(cond2_risk_roll_20_21)## An object of class <cond_portvine_roll>
##
## --- Conditional settings ---
## Conditional variable(s): eurostoxx50 iberdrola
## Number of conditional estimated risk measures: 7000
## Conditioning quantiles: 0.05 0.1 0.25 0.5
##
## --- Marginal models ---
## Number of ARMA-GARCH/ marginal windows: 2
## Train size: 300
## Refit size: 50
##
## --- Vine copula models ---
## Number of vine windows: 2
## Train size: 200
## Refit size: 50
## Vine copula type: dvine
## Vine family set: parametric
##
## --- Risk estimation ---
## Risk measures estimated: VaR ES_mean
## Alpha levels used: 0.01 0.025 0.05 0.25 0.5 0.75 0.95
## Number of estimated risk measures: 1400
## Number of samples for each risk estimation: 1e+05
##
## Time taken: 207.8523 minutes.A look at the D-vines
Here one uses D-vines with the fixed positions of the indices at the rightmost leafs. One can have a look whether the ordering changes over time and which asset seems to be most influenced by the market index. Again also the fitted bivariate copulas are of interest.
One starts with the first time frame.
labeled_vinecop_plot(fitted_vines(cond2_risk_roll_16_19)[[1]])
labeled_vinecop_plot(fitted_vines(cond2_risk_roll_16_19)[[3]])
labeled_vinecop_plot(fitted_vines(cond2_risk_roll_16_19)[[6]])
The Eurostoxx 50 index seems to be more influencial for the portfolio and thus takes the second rightmost position in the ordering of the D-vine.
bicops_used(fitted_vines(cond2_risk_roll_16_19)[[1]])##
## bb1 bb8 frank gaussian gumbel indep joe t
## 1 8 10 4 6 6 3 7bicops_used(fitted_vines(cond2_risk_roll_16_19)[[3]])##
## bb1 bb7 bb8 clayton frank gaussian gumbel indep
## 3 1 3 2 15 5 4 6
## joe t
## 2 4bicops_used(fitted_vines(cond2_risk_roll_16_19)[[6]])##
## bb1 bb7 bb8 clayton frank gaussian gumbel indep
## 3 1 1 4 13 4 8 5
## joe t
## 2 4Now the second time frame.
labeled_vinecop_plot(fitted_vines(cond2_risk_roll_20_21)[[1]])
labeled_vinecop_plot(fitted_vines(cond2_risk_roll_20_21)[[2]])
Very close pattern to the one of the first time frame.
bicops_used(fitted_vines(cond2_risk_roll_20_21)[[1]])##
## bb1 bb7 bb8 clayton frank gaussian gumbel indep
## 2 4 2 2 7 3 6 11
## joe t
## 2 6bicops_used(fitted_vines(cond2_risk_roll_20_21)[[2]])##
## bb1 bb7 clayton frank gaussian gumbel indep joe
## 1 3 2 11 4 6 7 4
## t
## 7Similarly to the single conditional and unconditional case one can observe more copulas that stress tail dependence for the second time frame.
The conditional risk measure estimates
First goes the first time frame.
risk_estimates(cond2_risk_roll_16_19, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "estimation window", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variables: Eurostoxx 50, Iberdrola",
"<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
"."))
risk_estimates(cond2_risk_roll_16_19, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "black", size = .6, alpha = 0.5) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
cond2_risk_roll_16_19,
risk_measures = "ES_mean",
cond_u = c("resid"),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_16_19 %>%
mutate(row_num = 1:nrow(msci_spain_16_19)),
by = "row_num"),
col = "#37d925"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "estimation window", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variables: Eurostoxx 50, Iberdrola
<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>",
"The
ES estimates conditioned on the **realized residuals** are drawn in
<span style='color:#37d925'>**green**</span>."
))
Now the second time frame.
risk_estimates(cond2_risk_roll_20_21, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "forecasting window (2021)", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variables: Eurostoxx 50, Iberdrola",
"<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
"."))
risk_estimates(cond2_risk_roll_20_21, risk_measures = "ES_mean",
cond_u = c(0.05, 0.1, 0.25, 0.5),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num") %>%
ggplot() +
geom_line(
aes(x = date, y = realized), col = "#828282", size = .6) +
geom_line(aes(x = date, y = risk_est, col = fct_rev(factor(cond_u))),
size = 0.5) +
geom_line(aes(x = date, y = risk_est),
data = risk_estimates(
cond2_risk_roll_20_21,
risk_measures = "ES_mean",
cond_u = c("resid"),
alpha = 0.025, exceeded = TRUE) %>%
left_join(msci_spain_20_21 %>%
mutate(row_num = 1:nrow(msci_spain_20_21)),
by = "row_num"),
col = "#37d925"
) +
scale_color_manual(values = c("#75a9fa", "#2d76eb", "#3567b5", "#133975")) +
labs(title = "Quantile based conditional Expected Shortfall",
col = "Quantile level",
x = "forecasting window (2021)", y = "portfolio log returns",
subtitle = paste0(
"Alpha level: 2.5%<br>Conditional variables: Eurostoxx 50, Iberdrola
<br>",
"The realized portfolio log returns are given in ",
"<span style='color:",
"#828282",
"'>**grey**</span>",
".", "<br>",
"The
ES estimates conditioned on the **realized residuals** are drawn in
<span style='color:#37d925'>**green**</span>."
))